home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / LWP / Protocol / http.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  4.0 KB  |  167 lines
  1.  
  2. package LWP::Protocol::http;
  3.  
  4. require LWP::Debug;
  5. require LWP::Protocol;
  6. require LWP::Socket;
  7. require HTTP::Request;
  8. require HTTP::Response;
  9. require HTTP::Status;
  10.  
  11. use Carp ();
  12.  
  13. @ISA = qw(LWP::Protocol);
  14.  
  15. use strict;
  16.  
  17. my $httpversion  = 'HTTP/1.0';     # for requests
  18. my $endl         = "\015\012";     # how lines should be terminated;
  19.  
  20. sub _new_socket
  21. {
  22.     LWP::Socket->new;
  23. }
  24.  
  25. sub request
  26. {
  27.     my($self, $request, $proxy, $arg, $size, $timeout) = @_;
  28.     LWP::Debug::trace('()');
  29.  
  30.     $size ||= 4096;
  31.  
  32.     my $method = $request->method;
  33.     unless ($method =~ /^[A-Za-z0-9_!#\$%&'*+\-.^`|~]+$/) {     # HTTP token
  34.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  35.                   'Library does not allow method ' .
  36.                   "$method for 'http:' URLs";
  37.     }
  38.  
  39.     my $url = $request->url;
  40.     my($host, $port, $fullpath);
  41.  
  42.     if (defined $proxy) {
  43.     $host = $proxy->host;
  44.     $port = $proxy->port;
  45.     $fullpath = $url->as_string;
  46.     }
  47.     else {
  48.     $host = $url->host;
  49.     $port = $url->port;
  50.     $fullpath = $url->full_path;
  51.     }
  52.  
  53.     alarm($timeout) if $self->use_alarm and $timeout;
  54.  
  55.     my $socket = $self->_new_socket();
  56.     $socket->connect($host, $port);
  57.  
  58.     my $request_line = "$method $fullpath $httpversion$endl";
  59.  
  60.  
  61.     my $content = $request->content;
  62.  
  63.     my $contRef;
  64.     if (defined $content){
  65.     $contRef = ref($content) ? $content : \$content;
  66.     if (ref($contRef) eq 'SCALAR') {
  67.         $request->header('Content-Length', length $$contRef)
  68.           if length $$contRef;
  69.     } elsif (ref($contRef) eq 'CODE') {
  70.         Carp::croak('No Content-Length header for request with content')
  71.           unless $request->header('Content-Length');
  72.     } else {
  73.         Carp::croak("Illegal content in request ($content)");
  74.     }
  75.     }
  76.  
  77.     $request->header('Host', $url->netloc);
  78.  
  79.     $socket->write($request_line . $request->headers_as_string($endl) . $endl);
  80.     if (defined $content) {
  81.     if (ref($contRef) eq 'CODE') {
  82.         $socket->write($contRef, $timeout);
  83.     } else {
  84.         $socket->write($$contRef, $timeout);
  85.     }
  86.     }
  87.  
  88.     LWP::Debug::debug('reading response');
  89.  
  90.     my $res = "";
  91.     my $buf = "";
  92.     my $response;
  93.  
  94.     while ($socket->read(\$buf, undef, $timeout)) {
  95.     $res .= $buf;
  96.     if ($res =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
  97.         my($ver,$code,$msg) = ($1, $2, $3);
  98.         $msg =~ s/\015$//;
  99.         LWP::Debug::debug("$ver $code $msg");
  100.         $response = HTTP::Response->new($code, $msg);
  101.         $response->protocol($ver);
  102.  
  103.         while ($res !~ /\015?\012\015?\012/) {
  104.         LWP::Debug::debug("need more data for headers");
  105.         last unless $socket->read(\$buf, undef, $timeout);
  106.         $res .= $buf;
  107.         }
  108.  
  109.         my($key, $val);
  110.         while ($res =~ s/([^\012]*)\012//) {
  111.         my $line = $1;
  112.  
  113.         my $save = "$line\012"; 
  114.  
  115.         $line =~ s/\015$//;
  116.         last unless length $line;
  117.  
  118.         if ($line =~ /^([a-zA-Z0-9_\-]+)\s*:\s*(.*)/) {
  119.             $response->push_header($key, $val) if $key;
  120.             ($key, $val) = ($1, $2);
  121.         } elsif ($line =~ /^\s+(.*)/) {
  122.             unless ($key) {
  123.             LWP::Debug::debug("Illegal continuation header");
  124.             $res = "$save$res";
  125.             last;
  126.             }
  127.             $val .= " $1";
  128.         } else {
  129.             LWP::Debug::debug("Illegal header '$line'");
  130.             $res = "$save$res";
  131.             last;
  132.         }
  133.         }
  134.         $response->push_header($key, $val) if $key;
  135.         last;
  136.  
  137.     } elsif ((length($res) >= 5 and $res !~ /^HTTP\//) or
  138.          $res =~ /\012/ ) {
  139.         LWP::Debug::debug("HTTP/0.9 assume OK");
  140.         $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
  141.         $response->protocol('HTTP/0.9');
  142.         last;
  143.  
  144.     } else {
  145.         LWP::Debug::debug("need more data to know which protocol");
  146.     }
  147.     };
  148.     die "Unexpected EOF" unless $response;
  149.  
  150.     $socket->pushback($res) if length $res;
  151.     $response->request($request);
  152.  
  153.     alarm($timeout) if $self->use_alarm and $timeout;
  154.  
  155.     $response = $self->collect($arg, $response, sub {
  156.     LWP::Debug::debug('Collecting');
  157.     my $content = '';
  158.     my $result = $socket->read(\$content, $size, $timeout);
  159.     return \$content;
  160.     } );
  161.     $socket = undef;  # close it
  162.  
  163.     $response;
  164. }
  165.  
  166. 1;
  167.